home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 5
/
Apprentice-Release5.iso
/
Source Code
/
Libraries
/
SAT 2.3.8
/
Demos
/
StepPlatform Demo ƒ
/
StepPlatform.p
< prev
next >
Wrap
Text File
|
1996-05-11
|
9KB
|
271 lines
{ StepPlatform by Nissan Zafrir, based on MyPlatform and StepZkrolly}
{ Modifications by Ingemar R:}
{ Scroll-length timed after TickCount in order to make it fast enough on slow Macs}
{ Replaced ox/oy by gSAT.wind.port->portRect.left and .top (ox/oy are obsolete)}
{ B/W icons and patterns}
{ Centered window}
{ Aligned scrolling to multiples of 8 (to account for a limitation in the 1-bit and 4-bit blitters)}
(*}
{Desirable improvements:}
{• The man should look better}
{• Some kind of opponents?}
{• Ladders?}
{• Better, more general rect-bounce utilities? (I.e. using SATToolbox.)}
{*)
program StepPlatform;
uses
{$ifc UNDEFINED THINK_PASCAL}
Types, QuickDraw, Menus, Windows, TextEdit, Fonts, Dialogs,{}
Memory, ToolUtils, Events, OSUtils,{}
{$endc}
SAT, MySlotVBL, PlatformGlobals, sPlayerSprite, sPlatForm, sHMovPlatform, sMovPlatform, sEmptyPlatform, InformUser;
var
thepat: SATPatHandle;
ignoreSp: SpritePtr;
p: Point;
{playerSp: SpritePtr;}
gWind: WindowPtr;
gVBLInstalled: Boolean;
r: Rect;
const
scrollSizeH = 512;
scrollSizeV = 384;
{playerSp^.position -> viewPoint}
{scrollSizeH -> ?}
{}
{(Ingemar's private notes)}
{Mer att fixa: Kan ScrollScreen göras så den alltid scrollar direkt, i ett steg?}
{Då skulle "vanlig" scroll fixa sig med samma rutin! Specialfall av scrollSpeed?}
{Nytt namn - SATScroll? Eller om två rutiner, SATScroll och SATStepScroll?}
function ScrollScreen (viewPoint: Point; marginH, marginV, scrollSpeed: Integer): Boolean;
{const}
{sco = 8; {the speed of the scroll, number of pixels per *tick*}
var
startTicks, frameTime, step: LongInt;
srcRect: Rect;
where, were: Point;
nowOff: Point;
scrollSizeH, scrollSizeV: Integer;
function max (x, y: Integer): Integer;
begin
if x > y then
max := x
else
max := y;
end; {max}
function min (x, y: Integer): Integer;
begin
if x < y then
min := x
else
min := y;
end; {min}
begin
scrollSizeH := gSAT.wind.port^.portRect.right - gSAT.wind.port^.portRect.left;
scrollSizeV := gSAT.wind.port^.portRect.bottom - gSAT.wind.port^.portRect.top;
frameTime := 1;
{ If the player sprite is at the border, scroll!}
if ((viewPoint.h + marginH > scrollSizeH + gSAT.wind.port^.portRect.left) or (viewPoint.h - marginH < gSAT.wind.port^.portRect.left) or (viewPoint.v + marginV > scrollSizeV + gSAT.wind.port^.portRect.top) or (viewPoint.v - marginV < gSAT.wind.port^.portRect.top)) then
{gSAT.wind.port->portRect.left/top = ox/oy!}
begin
SATSetPortScreen;
nowOff := gSAT.wind.port^.portRect.topLeft; {Get old origin}
were := nowOff;
where := viewPoint;
where.h := where.h - BSR(scrollSizeH, 1);
where.v := where.v - BSR(scrollSizeV, 1);
if where.h < 0 then
where.h := 0;
if where.v < 0 then
where.v := 0;
if where.h + scrollSizeH > gSAT.offSizeH then
where.h := gSAT.offSizeH - scrollSizeH;
if where.v + scrollSizeV > gSAT.offSizeV then
where.v := gSAT.offSizeV - scrollSizeV;
where.h := BitAnd(where.h, $fff8); { Scroll only to multiples of 8, so we won't confuse the 4-bit and 1-bit blitters!}
repeat
begin
startTicks := TickCount;
step := scrollSpeed * frameTime;
if (nowOff.h > where.h) then
nowOff.h := max(nowOff.h - step, where.h);
if (nowOff.h < where.h) then
nowOff.h := min(nowOff.h + step, where.h);
if (nowOff.v > where.v) then
nowOff.v := max(nowOff.v - step, where.v);
if (nowOff.v < where.v) then
nowOff.v := min(nowOff.v + step, where.v);
SetOrigin(nowOff.h, nowOff.v);
gSAT.wind.bounds := gSAT.wind.port^.portRect; { Synch gSAT.wind.bounds with the portRect!}
srcRect := gSAT.wind.port^.portRect;
CopyBits(gSAT.offScreen.port^.portBits, gSAT.wind.port^.portBits, srcRect, srcRect, srcCopy, nil);
frameTime := TickCount - startTicks;
end;
until not ((nowOff.h <> where.h) or (nowOff.v <> where.v));
end;
end; {ScrollScreen}
procedure SetupWind;
var
zr: Rect;
wrld: SysEnvRec;
begin
{• Since SAT hasn't been initialized, we can't use gSAT.colorFlag but }
{• have to check environs ourselves.}
if (noErr <> SysEnvirons(1, wrld)) then
;{• ignore errors.}
{ SetRect(&zr, (512-scrollSizeH)/2, 0, (512-scrollSizeH)/2 + scrollSizeH, 0 + scrollSizeV);}
{ no- center on screen instead!}
SetRect(zr, 0, 0, scrollSizeH, scrollSizeV);
{$IFC UNDEFINED THINK_PASCAL}
OffsetRect(zr, (qd.screenBits.bounds.right - qd.screenBits.bounds.left - scrollSizeH) div 2, (qd.screenBits.bounds.bottom - qd.screenBits.bounds.top - scrollSizeV) div 2);
{$ELSEC}
OffsetRect(zr, (screenBits.bounds.right - screenBits.bounds.left - scrollSizeH) div 2, (screenBits.bounds.bottom - screenBits.bounds.top - scrollSizeV) div 2);
{$ENDC}
if (wrld.hasColorQD) then
gWind := NewCWindow(nil, zr, '', false, plainDBox, WindowPtr(-1), false, 0)
else
gWind := NewWindow(nil, zr, '', false, plainDBox, WindowPtr(-1), false, 0);
end; {SetupWind}
function IsOptionPressed: Boolean;
var
km: KeyMap;
begin
GetKeys(km);
IsOptionPressed := km[56];
end;
{main }
var
tempRect: Rect;
e: EventRecord;
startTicks: Longint;
where: Point;
begin
{$IFC UNDEFINED THINK_PASCAL}
SATInitToolbox;
GetDateTime(qd.randSeed);
{$ELSEC}
GetDateTime(randSeed);
{$ENDC}
SATConfigure(true, kVPositionSort, kBackwardCollision, 64);
SetupWind;
SetRect(r, 0, 0, 1000, 484); {the offscreen size}
SATCustomInit(0, 0, r, gWind, nil, false, false, false, true, false);
SATSetSpriteRecSize(sizeof(Sprite));
ShowWindow(gSAT.wind.port);
SelectWindow(gSAT.wind.port);
SATHideMBar(gWind);
(* fill the backscreen in a pattren *)
SATSetPortBackScreen;
if (IsOptionPressed) then
thepat := SATGetPat(SATRand(5) + 128) { choose a Pat in Random}
else
thepat := SATGetPat(128);{128-brown wall, 130-gray wall pattren}
SATPenPat(thepat);
SetRect(tempRect, 0, 0, gSAT.offSizeH, gSAT.offSizeV + 100);
PaintRect(tempRect);
CopyBits(gSAT.backScreen.port^.portBits, gSAT.offScreen.port^.portBits, gSAT.offScreen.port^.portRect, gSAT.offScreen.port^.portRect, srcCopy, nil);
SATBackChanged(gSAT.offScreen.port^.portRect);
SATRedraw;
(*Initialize all sprite units*)
InitPlayerSprite;
InitPlatform;
InitEmptyPlatform;
InitMovPlatform;
InitHMovPlatform;
InitInformationArea;
SATRedraw;
(* SetUp my Sprites *)
GetMouse(p);
playerSp := PlSpritePtr(SATNewSprite(1, p.h, p.v, @SetupPlayerSprite)); { Keep Player Sprite}
ignoreSp := SATNewSprite(0, 0, 350, @SetupEmptyPlatform); { the Floor Platform}
SetRect(ignoreSp^.hotRect, 0, 0, gSAT.offSizeH - 150, 20);
ignoreSp := SATNewSprite(0, 55, 300, @SetupPlatform); { Standing Platform}
ignoreSp := SATNewSprite(0, 245, 235, @SetupPlatform); { Standing Platform}
ignoreSp := SATNewSprite(55, 355, 200, @SetupMovPlatform); {50=MinV 200=MaxV}
{ignoreSp->position.h=30; // I can change the defeults}
ignoreSp := SATNewSprite(100, 55, 200, @SetupMovPlatform); {100=MinV 230=MaxV}
ignoreSp := SATNewSprite(128, 270, 120, @SetupHMovPlatform); {120=MinH 150=MaxH}
ignoreSp^.speed.h := 2;
ignoreSp := SATNewSprite(250, 850, 400, @SetupMovPlatform); {50=MinV 200=MaxV}
ignoreSp := SATNewSprite(55, 700, 250, @SetupMovPlatform); {50=MinV 200=MaxV}
ignoreSp := SATNewSprite(430, 630, 85, @SetupHMovPlatform); {50=MinV 200=MaxV}
(*Update the game window once more, so the pattern and what we drawn in DrawInfo are shown. *)
SATRedraw;
HideCursor;
SATSoundOff;
{if (gSAT.colorFlag) then { Can't do SlotVInstall without CQD, but MySLotVBL handles that!}
if (IsOptionPressed) then
if InstallVBL(gSAT.wind.device) = noErr then
begin
SATInstallSynch(@SATSynch); {WaitForSync}
SysBeep(7);
gVBLInstalled := true;
end;
(* the main loop *)
gSAT.wind.bounds := gSAT.wind.port^.portRect;
SATSetPortScreen;
SATRedraw;
repeat
startTicks := TickCount; {If not VBL-synched}
SATRun(true); {!IsOptionPressed()}
where.h := playerSp^.position.h + 32;
where.v := playerSp^.position.v + 32;
if ScrollScreen(where, 32, 32, 8) then
;
if IsOptionPressed then
DrawProgrammerInfo;
{if (IsOptionPressed()) if (WaitNextEvent ( everyEvent, &e, 10, nil )) ;}
if not gVBLInstalled then while TickCount < startTicks + 1 do
; {Max 60 fps}
until Button;
(* cleanning up *)
SATSetPortScreen;
{ if gVBLInstalled then}
{ RemoveVBLCounter;}
SATSoundShutup; {Free sound channels}
SATShowMBar(gWind); {Restore the menu bar}
RemoveVBL; {Turn off the VBL task, if any}
ShowCursor;
FlushEvents(everyEvent, 0);
end. {main}